home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / USING.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-26  |  6KB  |  174 lines
  1. Program Test_PrintUsing;
  2. {$C-,V-}
  3. { this program can be used to test the PrintUsing procedure in the
  4.   file USING.INC. The print mask rules are as follows:
  5.  
  6.    Mask                 Description
  7.    ---------------      ---------------------------------------------
  8.    **##.##              the leading '**' reserve space for digits as
  9.                         well as causing the field to filled in with '*'
  10.                         in all blank positions
  11.  
  12.    ####.##-             The number is output and if negative the sign
  13.                         is after j\e number otherwise the sign is blanked.
  14.  
  15.    $$##.##              The '$$' prints a '$' just prior to the first
  16.                         digit of the number. The '$$' counts as only
  17.                         one '#'.
  18.  
  19.    ##,###.##            Commas to be printed in the output field should
  20.                         be inserted into the format.
  21.  
  22.    If the number exceeds the format the number will be printed using the
  23.    default format preceeded by a '%'.
  24.  
  25. }
  26. type
  27.   Str80                 =    String[80];
  28.  
  29. {Begin  using.inc     }
  30. procedure PrintUsing(var FileOut:Text; Mask:Str80; Number:real);
  31. { This procedure emulates the print using function of BASIC-PLUS }
  32. { on DEC's RSTS/E. All functions except those for printing       }
  33. { exponential format are implemented as described in the language}
  34. { manual.                                                         }
  35.  
  36. var
  37.   TrailSign,
  38.   AsteriskFill,
  39.   FloatDollar,
  40.   FirstDigit,
  41.   Good             :         boolean;
  42.   Sign,
  43.   I,
  44.   digit,
  45.   Rdigit,
  46.   Point,
  47.   Dol,
  48.   k                :         integer;
  49.   Source           :         String[80];
  50. begin
  51.   TrailSign:=Copy(Mask,Length(Mask),1)='-';
  52.   If Number > 0.0 then
  53.     Sign:=1
  54.   else begin { number is negative }
  55.          Sign:=-1;
  56.          If TrailSign then
  57.            Number:=-Number;
  58.        end;  { number is negative }
  59.   AsteriskFill:=Copy(Mask,1,2)='**';
  60.   FloatDollar:=Copy(Mask,1,2)='$$';
  61.   Point:=0;
  62.   digit:=0;
  63.   Rdigit:=0;
  64.   Good:=true;
  65.   If AsteriskFill and FloatDollar then
  66.     Good:=false;
  67.   if Good then
  68.     begin  { format valid }
  69.       for I:=1 to Length(Mask) do
  70.           case Mask[I] of
  71.           '#'  :  begin
  72.                     digit:=digit+1;
  73.                     If (Point>0) then
  74.                       Rdigit:=Rdigit+1;
  75.                   end;
  76.           '.'  :  Point:=I;
  77.           end;
  78.       If FloatDollar then
  79.         digit:=digit+1
  80.       else If AsteriskFill then
  81.         digit:=digit+2;
  82.       If Point>0 then
  83.         digit:=digit+1;
  84.       Str(Number:digit:Rdigit,Source);
  85.       If Length(Source)>digit then
  86.         Good:=false;
  87.       If Good then
  88.         begin { not too many digits }
  89.           If (Rdigit>0) then
  90.             begin { decimal point expected }
  91.               Point:=Pos('.',Source);
  92.               If (Point>0) then
  93.                 Source:=Copy(Source,1,Point-1)+Copy(Source,Point+1,Rdigit);
  94.             end;  { decimal point expected }
  95.           k:=0;
  96.           Dol:=0;
  97.           FirstDigit:=false;
  98.           for I:=1 to Length(Mask) do
  99.             begin { move digits into mask loop }
  100.               case Mask[I] of
  101.               ',' : If Not FirstDigit then
  102.                         If AsteriskFill then
  103.                           Mask[I]:='*'
  104.                         else If FloatDollar then
  105.                           Mask[I]:=' ';
  106.               '#',
  107.               '*' : begin { digit holder }
  108.                       k:=k+1;
  109.                       Mask[I]:=Source[k];
  110.                       If (Mask[I]=' ') then
  111.                         begin { blank entry }
  112.                           if AsteriskFill then
  113.                             Mask[I]:='*';
  114.                         end   { blank entry }
  115.                       else
  116.                         If Not FirstDigit then
  117.                           begin { floating dollar and non blank entry }
  118.                             FirstDigit:=true;
  119.                             If FloatDollar then
  120.                               Mask[I-1]:='$';
  121.                             FloatDollar:=false;
  122.                           end;  { floating dollar and non blank entry }
  123.                     end;  { digit holder }
  124.               '$' : begin { dollar sign }
  125.                       If FloatDollar then
  126.                         begin { floating dollar sign requested }
  127.                           Dol:=Dol+1;
  128.                           Mask[I]:=' ';
  129.                           If Dol=2 then
  130.                             begin { 2nd dollar sign encountered }
  131.                               k:=k+1;
  132.                               Mask[I]:=Source[k];
  133.                             end;  { 2nd dollar sign encountered }
  134.                         end;  { floating dollar sign requested }
  135.                     end;  { dollar sign }
  136.               end;  { case Mask[I] of }
  137.             end;  { move digits into mask loop }
  138.           If TrailSign then
  139.             if Sign=1 then
  140.               Mask[Length(Mask)]:=' ';
  141.           write(FileOut,Mask);
  142.         end;  { not too many digits }
  143.     end;   { format valid }
  144.   If Not Good then
  145.      write(FileOut,'%',Number);
  146. end;
  147.  
  148. var
  149.   Mask                  :    String[20];
  150.   Number                :    Real;
  151.   Junk                  :    Integer;
  152.  
  153. begin
  154.   Mask:='$$##,###.##-';
  155.   Number:=1234.45;
  156.   PrintUsing(Con,Mask,Number);  { Output '  $1,234.45 '    }
  157.   writeln(Con);
  158.   Junk:=-444;
  159.   PrintUsing(Con,Mask,Junk);    { Output '    $444.00-'    }
  160.   writeln(Con);
  161.   Number:=446557899.;
  162.   Mask:='###-##-####';
  163.   PrintUsing(Con,Mask,Number);  { Output '446-55-7899'     }
  164.   writeln(Con);
  165.   Mask:='**#,###,###.##-';
  166.   Number:=-12345.66;
  167.   PrintUsing(Con,Mask,Number);  { Output '*****12,345.66-' }
  168.   writeln(Con);
  169.   Mask:='##.#';
  170.   Junk:=345;
  171.   PrintUsing(Con,Mask,Junk);    { Output '% 3.4500000000E+02'}
  172.   writeln(Con);
  173. end.
  174.